home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / b / b.lha / B / src / bint / b2ana.c < prev    next >
Encoding:
C/C++ Source or Header  |  1988-11-24  |  7.6 KB  |  350 lines
  1. /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
  2.  
  3. /* $Header: b2ana.c,v 1.4 85/08/22 16:54:05 timo Exp $ */
  4.  
  5. /* Prepare for code generation -- find out which tags are targets */
  6.  
  7. #include "b.h"
  8. #include "b1obj.h"
  9. #include "b2nod.h"
  10. #include "b2gen.h" /* Must be after b2nod.h */
  11. #include "b3err.h"
  12. #include "b3env.h"
  13. #include "b3sou.h" /* For get_pname */
  14.  
  15.  
  16. Visible int nextvarnumber; /* Counts local targets (including formals) */
  17.  
  18. Visible value formals, locals, globals, mysteries, refinements;
  19.  
  20.  
  21. Visible value *setup(t) parsetree t; {
  22.     typenode n= Nodetype(t);
  23.     bool in_prmnv= !Unit(n);
  24.     nextvarnumber= 0;
  25.     formals= mk_elt();
  26.     mysteries= mk_elt();
  27.     if (in_prmnv) {
  28.         globals= copy(prmnv->tab);
  29.         locals= Vnil;
  30.         refinements= mk_elt();
  31.         return Command(n) ? &globals : Pnil;
  32.     } else {
  33.         globals= mk_elt();
  34.         locals= mk_elt();
  35.         refinements=
  36.             copy(*Branch(t, n == HOW_TO ? HOW_R_NAMES : FPR_R_NAMES));
  37.         unit_context(t);
  38.         return &locals;
  39.     }
  40. }
  41.  
  42. Hidden Procedure unit_context(t) parsetree t; {
  43.     cntxt= In_unit;
  44.     release(uname); uname= get_pname(t);
  45. }
  46.  
  47. Visible Procedure cleanup() {
  48.     release(formals);
  49.     release(locals);
  50.     release(globals);
  51.     release(mysteries);
  52.     release(refinements);
  53. }
  54.  
  55. /* ********************************************************************    */
  56.  
  57. /* Analyze parse tree, finding the targets and formal parameters.
  58.    Formal parameters of HOW'TO's are of course found in the unit heading.
  59.    Formal parameters of YIELDs and TESTs are treated as local targets.
  60.    Global targets are also easily found: they are mentioned in a SHARE command.
  61.    Local targets appear on their own or in collateral forms after PUT IN,
  62.    DRAW or CHOOSE, or as bound tags after FOR, SOME, EACH or NO.
  63.    Note that DELETE x, REMOVE e FROM x, or PUT e IN x[k] (etc.) don't
  64.    introduce local targets, because in all these cases x must have been
  65.    initialized first.  This speeds up our task of finding targets,
  66.    since we don't have to visit all nodes: only nodes that may contain
  67.    commands or tests, and the positions mentioned here, need be visited.
  68.    (And of course unit headings).
  69.    We don't have to look for refinements since these are already known
  70.    from the unit heading.
  71.  */
  72.  
  73. Hidden Procedure a_tag(name, targs) value name; value *targs; {
  74.     value *aa; int varnumber;
  75.     if (locals != Vnil && envassoc(locals, name)) return;
  76.     if (envassoc(globals, name)) return;
  77.     if (envassoc(formals, name)) return;
  78.     if (envassoc(refinements, name)) {
  79.         if (targs != &mysteries)
  80.             fixerr(MESS(4600, "a refinement may not be used as a target"));
  81.         return;
  82.     }
  83.     if (aa= envassoc(mysteries, name)) {
  84.         if (targs == &mysteries) return;
  85.         varnumber= SmallIntVal(*aa);
  86.         e_delete(&mysteries, name);
  87.     }
  88.     else if (targs != &globals) varnumber= nextvarnumber++;
  89.     else varnumber= 0;
  90.     e_replace(MkSmallInt(varnumber), targs, name);
  91. }
  92.  
  93. Hidden Procedure a_fpr_formals(t) parsetree t; {
  94.     typenode n= Nodetype(t);
  95.     switch (n) {
  96.     case TAG:
  97.         break;
  98.     case MONF: case MONPRD:
  99.         analyze(*Branch(t, MON_RIGHT), &locals);
  100.         break;
  101.     case DYAF: case DYAPRD:
  102.         analyze(*Branch(t, DYA_LEFT), &locals);
  103.         analyze(*Branch(t, DYA_RIGHT), &locals);
  104.         break;
  105.     default: syserr(MESS(4601, "a_fpr_formals"));
  106.     }
  107. }
  108.  
  109. Visible Procedure analyze(t, targs) parsetree t; value *targs; {
  110.     typenode nt; string s; char c; int n, k, len; value v;
  111.     if (!Is_node(t) || !still_ok) return;
  112.     nt= Nodetype(t);
  113.     if (nt < 0 || nt >= NTYPES) syserr(MESS(4602, "analyze bad tree"));
  114.     s= gentab[nt];
  115.     if (s == NULL) return;
  116.     n= First_fieldnr;
  117.     while ((c= *s++) != '\0' && still_ok) {
  118.         switch (c) {
  119.         case '0':
  120.         case '1':
  121.         case '2':
  122.         case '3':
  123.         case '4':
  124.         case '5':
  125.         case '6':
  126.         case '7':
  127.         case '8':
  128.         case '9':
  129.             n= (c - '0') + First_fieldnr;
  130.             break;
  131.         case 'c':
  132.             v= *Branch(t, n);
  133.             if (v != Vnil) {
  134.                 len= Nfields(v);
  135.                 for (k= 0; k < len; ++k)
  136.                     analyze(*Field(v, k), targs);
  137.             }
  138.             ++n;
  139.             break;
  140.         case '#':
  141.             curlino= *Branch(t, n);
  142.             /* Fall through */
  143.         case 'l':
  144.         case 'v':
  145.             ++n;
  146.             break;
  147.         case 'm':
  148.             analyze(*Branch(t, n), &mysteries);
  149.             ++n;
  150.             break;
  151.         case 'g':
  152.             analyze(*Branch(t, n), &globals);
  153.             ++n;
  154.             break;
  155.         case '!':
  156.             analyze(*Branch(t, n),
  157.                 locals != Vnil ? &locals : &globals);
  158.             ++n;
  159.             break;
  160.         case 'x':
  161.             curline= *Branch(t, n);
  162.             /* Fall through */
  163.         case 'a':
  164.         case 'u':    
  165.             analyze(*Branch(t, n), targs);
  166.             ++n;
  167.             break;
  168.         case 't':
  169.             analyze(*Branch(t, n), Pnil);
  170.             ++n;
  171.             break;
  172.         case 'f':
  173.             a_fpr_formals(*Branch(t, n));
  174.             ++n;
  175.             break;
  176.         case 'h':
  177.             v= *Branch(t, n);
  178.             if (v != Vnil && Is_text(v))
  179.                 a_tag(v, &formals);
  180.             else
  181.                 analyze(v, &formals);
  182.             ++n;
  183.             break;
  184.         case '=':
  185.             *Branch(t, n)= MkSmallInt(nextvarnumber);
  186.             ++n;
  187.             break;
  188.         case 'T':
  189.             if (targs != Pnil)
  190.                 a_tag((value)*Branch(t, TAG_NAME), targs);
  191.             break;
  192.         }
  193.     }
  194. }
  195.  
  196. /* ********************************************************************    */
  197.  
  198. /* Table describing the actions of the fixer for each node type */
  199.  
  200.  
  201. /*
  202.     LIST OF CODES AND THEIR MEANING
  203.  
  204.     char    fix        n?    analyze
  205.  
  206.     0-9            n= c-'0'
  207.  
  208.     #    set curlino    ++n    set curlino
  209.     =            ++n    set to nextvarnum
  210.     !    locate        ++n    analyze; force targs= &local
  211.     a    locate        ++n    analyze
  212.     c    collateral    ++n    analyze collateral
  213.     f    fpr_formals    ++n    a_fpr_formals
  214.     g            ++n    global
  215.     h            ++n    how'to formal
  216.     l    locate        ++n
  217.     m    actual param    ++n    mystery
  218.     t    test        ++n    analyze; set targs= 0
  219.     u    unit        ++n    analyze
  220.     v    evaluate    ++n
  221.     x    execute        ++n    analyze
  222.  
  223.     ?    special code for UNPARSED
  224.     C    special code for comparison
  225.     D    special code for DYAF
  226.     E    special code for DYAPRD
  227.     G    jumpto(l1)
  228.     H    here(&l1)
  229.     I    if (*Branch(t, n) != NilTree) jump2here(t)
  230.     J    jump2here(t)
  231.     K    hold(&st)
  232.     L    let_go(&st)
  233.     M    special code for MONF
  234.     N    special code for MONPRD
  235.     R    if (!reachable()) error("command cannot be reached")
  236.     S    jumpto(Stop)
  237.     T    special code for TAG
  238.     U    special code for user-defined-command
  239.     V    visit(t)
  240.     W    visit2(t, seterr(1))
  241.     X    visit(t) or lvisit(t) depending on flag
  242.     Y    special code for YIELD/TEST
  243.     Z    special code for refinement
  244.      
  245. */
  246.  
  247.  
  248. Visible string gentab[]= {
  249.  
  250.     /* HOW_TO */ "1h3xSu6=",
  251.     /* YIELD */ "2fV4xYu7=",
  252.     /* TEST */ "2fV4xYu7=",
  253.     /* REFINEMENT */ "H2xZSu",
  254.  
  255.     /* Commands */
  256.  
  257.     /* SUITE */ "#RVx3x",
  258.     /* PUT */ "vaV",
  259.     /* INSERT */ "vlV",
  260.     /* REMOVE */ "vlV",
  261.     /* CHOOSE */ "avV",
  262.     /* DRAW */ "aV",
  263.     /* SET_RANDOM */ "vV",
  264.     /* DELETE */ "lV",
  265.     /* CHECK */ "tV",
  266.     /* SHARE */ "g",
  267.  
  268.     /* WRITE */ "1vV",
  269.     /* READ */ "avV",
  270.     /* READ_RAW */ "aV",
  271.  
  272.     /* IF */ "tV2xJ",
  273.     /* WHILE */ "HtV2xGJ",
  274.     /* FOR */ "avHV3xGJ",
  275.  
  276.     /* SELECT */ "1x",
  277.     /* TEST_SUITE */ "#tW3xKIxL",
  278.     /* ELSE */ "#2x",
  279.  
  280.     /* QUIT */ "VS",
  281.     /* RETURN */ "vVS",
  282.     /* REPORT */ "tVS",
  283.     /* SUCCEED */ "VS",
  284.     /* FAIL */ "VS",
  285.  
  286.     /* USER_COMMAND */ "1mUV",
  287.     /* EXTENDED_COMMAND */ "1cV",
  288.  
  289.     /* Expressions, targets, tests */
  290.  
  291.     /* TAG */ "T",
  292.     /* COMPOUND */ "a",
  293.  
  294.     /* Expressions, targets */
  295.  
  296.     /* COLLATERAL */ "cX",
  297.     /* SELECTION */ "lvX",
  298.     /* BEHEAD */ "lvX",
  299.     /* CURTAIL */ "lvX",
  300.  
  301.     /* Expressions, tests */
  302.  
  303.     /* UNPARSED */ "?",
  304.  
  305.     /* Expressions */
  306.  
  307.     /* MONF */ "M1vV",
  308.     /* DYAF */ "Dv2vV",
  309.     /* NUMBER */ "V",
  310.     /* TEXT_DIS */ "1v",
  311.     /* TEXT_LIT */ "1vV",
  312.     /* TEXT_CONV */ "vvV",
  313.     /* ELT_DIS */ "V",
  314.     /* LIST_DIS */ "cV",
  315.     /* RANGE_DIS */ "vvV",
  316.     /* TAB_DIS */ "cV",
  317.  
  318.     /* Tests */
  319.  
  320.     /* AND */ "tVtJ",
  321.     /* OR */ "tVtJ",
  322.     /* NOT */ "tV",
  323.     /* SOME_IN */ "!vHVtGJ",
  324.     /* EACH_IN */ "!vHVtGJ",
  325.     /* NO_IN */ "!vHVtGJ",
  326.     /* SOME_PARSING */ "!vHVtGJ",
  327.     /* EACH_PARSING */ "!vHVtGJ",
  328.     /* NO_PARSING */ "!vHVtGJ",
  329.     /* MONPRD */ "N1vV",
  330.     /* DYAPRD */ "Ev2vV",
  331.     /* LESS_THAN */ "vvVC",
  332.     /* AT_MOST */ "vvVC",
  333.     /* GREATER_THAN */ "vvVC",
  334.     /* AT_LEAST */ "vvVC",
  335.     /* EQUAL */ "vvVC",
  336.     /* UNEQUAL */ "vvVC",
  337.     /* Nonode */ "",
  338.  
  339.     /* TAGformal */ "T",
  340.     /* TAGlocal */ "T",
  341.     /* TAGglobal */ "T",
  342.     /* TAGmystery */ "T",
  343.     /* TAGrefinement */ "T",
  344.     /* TAGzerfun */ "T",
  345.     /* TAGzerprd */ "T",
  346.  
  347.     /* ACTUAL */ "1mm",
  348.     /* FORMAL */ "1hh",
  349. };
  350.